home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
COMPILER
/
VP10B003
/
VPC
/
SOURCE
/
RTL
/
STRINGS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-06-21
|
17KB
|
532 lines
{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Runtime Library. Version 1.0. █}
{█ String Handling Unit (ASCIIZ) █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 1995 B&M&T Corporation █}
{█ ─────────────────────────────────────────────────█}
{█ Written by Vitaly Miryanov █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{$S-,R-,Q-,I-,Cdecl-,OrgName-,AlignRec-}
unit Strings;
interface
uses Use32;
function StrLen(Str: PChar): Word;
function StrEnd(Str: PChar): PChar;
function StrMove(Dest, Source: PChar; Count: Word): PChar;
function StrCopy(Dest, Source: PChar): PChar;
function StrECopy(Dest, Source: PChar): PChar;
function StrLCopy(Dest, Source: PChar; MaxLen: Word): PChar;
function StrPCopy(Dest: PChar; Source: String): PChar;
function StrCat(Dest, Source: PChar): PChar;
function StrLCat(Dest, Source: PChar; MaxLen: Word): PChar;
function StrComp(Str1, Str2: PChar): Integer;
function StrIComp(Str1, Str2: PChar): Integer;
function StrLComp(Str1, Str2: PChar; MaxLen: Word): Integer;
function StrLIComp(Str1, Str2: PChar; MaxLen: Word): Integer;
function StrScan(Str: PChar; Chr: Char): PChar;
function StrRScan(Str: PChar; Chr: Char): PChar;
function StrPos(Str1, Str2: PChar): PChar;
function StrUpper(Str: PChar): PChar;
function StrLower(Str: PChar): PChar;
function StrPas(Str: PChar): String;
function StrNew(Str: PChar): PChar;
procedure StrDispose(Str: PChar);
implementation
{ Returns the number of characters in Str, not counting the null }
{ terminator. }
function StrLen(Str: PChar): Word; assembler; {$USES edi} {$FRAME-}
asm
cld
mov edi,Str
or ecx,-1
xor eax,eax
repne scasb
sub eax,ecx
sub eax,2
end;
{ Returns a pointer to the null character that terminates Str. }
function StrEnd(Str: PChar): PChar; assembler; {$USES edi} {$FRAME-}
asm
cld
mov edi,Str
or ecx,-1
xor al,al
repne scasb
lea eax,[edi-1]
end;
{ Copies exactly Count characters from Source to Dest and returns Dest. }
{ Source and Dest may overlap. }
function StrMove(Dest, Source: PChar; Count: Word): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
mov esi,Source
mov edi,Dest
mov edx,edi
mov ecx,Count
cmp esi,edi
jae @@1
std
add esi,ecx
add edi,ecx
mov eax,ecx
and ecx,11b
shr eax,2
dec esi
dec edi
rep movsb
mov ecx,eax
sub esi,3
sub edi,3
rep movsd
jmp @@2
@@1:
cld
mov eax,ecx
shr ecx,2
and al,11b
rep movsd
mov cl,al
rep movsb
@@2:
mov eax,edx
end;
{ Copies Source to Dest and returns Dest. }
function StrCopy(Dest, Source: PChar): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Source
mov esi,edi
xor al,al
or ecx,-1
repne scasb
not ecx
mov dl,cl
mov edi,Dest
mov eax,edi
shr ecx,2
and dl,11b
rep movsd
mov cl,dl
rep movsb
end;
{ Copies Source to Dest and returns StrEnd(Dest). }
function StrECopy(Dest, Source: PChar): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Source
mov esi,edi
xor al,al
or ecx,-1
repne scasb
not ecx
mov al,cl
mov edi,Dest
shr ecx,2
and al,11b
rep movsd
mov cl,al
rep movsb
lea eax,[edi-1]
end;
{ Copies at most MaxLen characters from Source to Dest and returns Dest.}
function StrLCopy(Dest, Source: PChar; MaxLen: Word): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Source
mov esi,edi
mov ecx,MaxLen
mov edx,ecx
xor al,al
repne scasb
sub edx,ecx
mov ecx,edx
mov edi,Dest
mov eax,edi
shr ecx,2
and dl,11b
rep movsd
mov cl,dl
rep movsb
mov [edi].Byte,0
end;
{ Copies the Pascal style string Source into Dest and returns Dest. }
function StrPCopy(Dest: PChar; Source: String): PChar; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov esi,Source
mov edi,Dest
mov eax,edi
xor ecx,ecx
mov cl,[esi]
inc esi
mov dl,cl
shr ecx,2
and dl,11b
rep movsd
mov cl,dl
rep movsb
mov [edi].Byte,0
end;
{ Appends a copy of Source to the end of Dest and returns Dest. }
function StrCat(Dest, Source: PChar): PChar; assembler; {$USES None} {$FRAME+}
asm
push Dest
Call StrEnd
push eax
push Source
Call StrCopy
mov eax,Dest
end;
{ Appends at most MaxLen - StrLen(Dest) characters from Source to the }
{ end of Dest, and returns Dest. }
function StrLCat(Dest, Source: PChar; MaxLen: Word): PChar; assembler; {$USES None} {$FRAME+}
asm
push Dest
Call StrEnd
mov ecx,Dest
add ecx,MaxLen
sub ecx,eax
jbe @@1
push eax
push Source
push ecx
Call StrLCopy
@@1:
mov eax,Dest
end;
{ Compares Str1 to Str2. The return value is less than 0 if Str1 < Str2,}
{ 0 if Str1 = Str2, or greater than 0 if Str1 > Str2. }
function StrComp(Str1, Str2: PChar): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Str2
mov esi,edi
or ecx,-1
xor eax,eax
xor edx,edx
repne scasb
not ecx
mov edi,esi
mov esi,Str1
repe cmpsb
mov al,[esi-1]
mov dl,[edi-1]
sub eax,edx
end;
{ Compares Str1 to Str2, without case sensitivity. The return value is }
{ the same as StrComp. }
function StrIComp(Str1, Str2: PChar): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Str2
mov esi,edi
or ecx,-1
xor eax,eax
xor edx,edx
repne scasb
not ecx
mov edi,esi
mov esi,Str1
@@1:
repe cmpsb
je @@4
mov al,[esi-1]
cmp al,'a'
jb @@2
cmp al,'z'
ja @@2
sub al,'a'-'A'
@@2:
mov dl,[edi-1]
cmp dl,'a'
jb @@3
cmp dl,'z'
ja @@3
sub dl,'a'-'A'
@@3:
sub eax,edx
je @@1
@@4:
end;
{ Compares Str1 to Str2, for a maximum length of MaxLen characters. The }
{ return value is the same as StrComp. }
function StrLComp(Str1, Str2: PChar; MaxLen: Word): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Str2
mov esi,edi
mov eax,MaxLen
mov ecx,eax
jecxz @@1
mov edx,eax
xor eax,eax
repne scasb
sub edx,ecx
mov ecx,edx
mov edi,esi
mov esi,Str1
repe cmpsb
xor edx,edx
mov al,[esi-1]
mov dl,[edi-1]
sub eax,edx
@@1:
end;
{ Compares Str1 to Str2, for a maximum length of MaxLen characters, }
{ without case sensitivity. The return value is the same as StrComp. }
function StrLIComp(Str1, Str2: PChar; MaxLen: Word): Integer; assembler; {$USES esi,edi} {$FRAME-}
asm
mov edi,Str2
mov esi,edi
mov eax,MaxLen
mov ecx,eax
jecxz @@4
cld
mov edx,eax
xor eax,eax
repne scasb
sub edx,ecx
mov ecx,edx
mov edi,esi
mov esi,Str1
xor edx,edx
@@1:
repe cmpsb
je @@4
mov al,[esi-1]
cmp al,'a'
jb @@2
cmp al,'z'
ja @@2
sub al,'a'-'A'
@@2:
mov dl,[edi-1]
cmp dl,'a'
jb @@3
cmp dl,'z'
ja @@3
sub dl,'a'-'A'
@@3:
sub eax,edx
je @@1
@@4:
end;
{ Returns a pointer to the first occurrence of Chr in Str. If Chr does }
{ not occur in Str, StrScan returns NIL. The null terminator is }
{ considered to be part of the string. }
function StrScan(Str: PChar; Chr: Char): PChar; assembler; {$USES edi} {$FRAME-}
asm
cld
mov edi,Str
mov edx,edi
or ecx,-1
xor eax,eax
repne scasb
not ecx
mov edi,edx
mov al,Chr
repne scasb
mov al,0
jne @@1
lea eax,[edi-1]
@@1:
end;
{ Returns a pointer to the last occurrence of Chr in Str. If Chr does }
{ not occur in Str, StrRScan returns NIL. The null terminator is }
{ considered to be part of the string. }
function StrRScan(Str: PChar; Chr: Char): PChar; assembler; {$USES edi} {$FRAME-}
asm
cld
mov edi,Str
or ecx,-1
xor eax,eax
repne scasb
not ecx
std
dec edi
mov al,Chr
repne scasb
mov al,0
jne @@1
lea eax,[edi+1]
@@1:
end;
{ Returns a pointer to the first occurrence of Str2 in Str1. If Str2 }
{ does not occur in Str1, StrPos returns NIL. }
function StrPos(Str1, Str2: PChar): PChar; assembler; {$USES ebx,esi,edi} {$FRAME-}
asm
cld
xor al,al
mov edi,Str2
or ecx,-1
repne scasb
not ecx
dec ecx
je @@2
mov edx,ecx
mov edi,Str1
mov ebx,edi
or ecx,-1
repne scasb
not ecx
sub ecx,edx
jbe @@2
mov edi,ebx
@@1:
mov esi,Str2
lodsb
repne scasb
jne @@2
mov eax,ecx
mov ebx,edi
mov ecx,edx
dec ecx
repe cmpsb
mov ecx,eax
mov edi,ebx
jne @@1
lea eax,[edi-1]
jmp @@3
@@2:
xor eax,eax
@@3:
end;
{ Converts Str to upper case and returns Str. }
function StrUpper(Str: PChar): PChar; assembler; {$USES esi} {$FRAME-}
asm
cld
mov esi,Str
mov eax,esi
@@1:
mov dl,[esi]
test dl,dl
jz @@2
inc esi
cmp dl,'a'
jb @@1
cmp dl,'z'
ja @@1
sub dl,'a'-'A'
mov [esi-1],dl
jmp @@1
@@2:
end;
{ Converts Str to lower case and returns Str. }
function StrLower(Str: PChar): PChar; assembler; {$USES esi} {$FRAME-}
asm
cld
mov esi,Str
mov eax,esi
@@1:
mov dl,[esi]
test dl,dl
jz @@2
inc esi
cmp dl,'A'
jb @@1
cmp dl,'Z'
ja @@1
add dl,'a'-'A'
mov [esi-1],dl
jmp @@1
@@2:
end;
{ StrPas converts Str to a Pascal style string. }
function StrPas(Str: PChar): String; assembler; {$USES esi,edi} {$FRAME-}
asm
cld
mov edi,Str
or ecx,-1
xor al,al
repne scasb
not ecx
dec ecx
cmp ecx,255
jbe @@1
mov ecx,255
@@1:
mov esi,Str
mov edi,@Result
mov al,cl
stosb
shr ecx,2
and al,11b
rep movsd
mov cl,al
rep movsb
end;
{ Allocates a copy of Str on the heap. If Str is NIL or points to an }
{ empty string, StrNew returns NIL and doesn't allocate any heap space. }
{ Otherwise, StrNew makes a duplicate of Str, obtaining space with a }
{ call to the GetMem standard procedure, and returns a pointer to the }
{ duplicated string. The allocated space is StrLen(Str) + 1 bytes long. }
function StrNew(Str: PChar): PChar;
var
L: Word;
P: PChar;
begin
StrNew := nil;
if (Str <> nil) and (Str^ <> #0) then
begin
L := StrLen(Str) + 1;
GetMem(P, L);
if P <> nil then StrNew := StrMove(P, Str, L);
end;
end;
{ Disposes a string that was previously allocated with StrNew. If Str }
{ is NIL, StrDispose does nothing. }
procedure StrDispose(Str: PChar);
begin
if Str <> nil then FreeMem(Str, StrLen(Str) + 1);
end;
end.